home *** CD-ROM | disk | FTP | other *** search
//***************************************************************************** // OBJECT.CH // The CLIPPER OBJECTs HEADER v2.03 // Copyright (c) 1991, JHK, JHK-Software, Piestany // Please compile files with this header with switches: /N/M/W/A //----------------------------------------------------------------------------- //#define CLASSY //CLASSY users can use this line... #ifndef CLASSY #ifndef OCLIP #define OCLIP //Default is the OCLIP object system... #endif #endif //-------- language support --------------------------------------------------- //#define SLOVAK //can't be, this is a default! //#define ENGLISH //for english laguage support you must use this line! //-------- modify for more readable source codes ------------------------------ #define and .and. #define or .or. #define true .t. #define false .f. #define cr_lf (chr(13)+chr(10)) #define NTrim(n) LTrim(Str(n)) #define Swap(a,b) Eval({|p|p:=a,a:=b,b:=p}) #define Bell() Tone(400,0.2) #xcommand Assert(<f>[,<t>]) => if(!(<f>), Abort("Assertion failed: "+<"f">[+", "+<t>]), ) #xtranslate (<var> IN <a>,<b>) => (<a> <= <var> .and. <var> <= <b>) //-------- Unconditional break exception -------------------------------------- #xcommand BEGIN BREAK => PushBreak(ErrorBlock({|o|DoBreak(o)})); begin sequence #xcommand RECOVER BREAK [USING <var>] => recover [using <var>]; ErrorBlock(TopBreak()) #xcommand END BREAK => end; ErrorBlock(PopBreak()) #xcommand BREAKIF <lExpr> [WITH <obj>] => if <lExpr>; break [ <obj> ]; endif //-------- Standart Commands extension ---------------------------------------- #xtranslate ALERT( => OAlert( #xcommand ENDWHILE [<lExpr>] => [if <lExpr>; exit; end;] end #xcommand REPEAT => while .t. #xcommand LOOPIF <lExpr> => if <lExpr>; loop; end #xcommand EXITIF <lExpr> => if <lExpr>; exit; end #xcommand UNTIL <lExpr> => if <lExpr>; exit; end; end #xcommand ENDREPEAT => end #xcommand RETURNIF <lexpr> [WITH <xvalue, ...>] => if <lexpr>; return [ <xvalue> ]; endif #xcommand RETURN <cur> UPDATE WITH <new> => return Eval( {|t| t:=<cur>, if(nil==<new>,nil,<cur>:=<new>), t}) //From Nantucket News, Vol.5, No.4, 1991 (author Mike Schinkel) #xcommand FILL EMPTY <Var1> := <Value1>[, <VarN> := <ValueN>] => if(Empty(<Var1>), <Var1>:=<Value1>, nil)[; if(Empty(<VarN>), <VarN>:=<ValueN>, nil)] #xcommand FILL EMPTY <Var1> WITH <Value1>[, <VarN> WITH <ValueN>] => if(Empty(<Var1>), <Var1>:=<Value1>, nil)[; if(Empty(<VarN>), <VarN>:=<ValueN>, nil)] #xcommand DEFAULT <Var1> := <Value1>[, <VarN> := <ValueN>] => if(nil==<Var1>, <Var1>:=<Value1>, nil)[; if(nil==<VarN>, <VarN>:=<ValueN>, nil)] //From Nantucket News, Vol.5, No.4, 1991 (author Mike Schinkel) #xcommand DEFAULT <Var1> TO <Value1>[, <VarN> TO <ValueN>] => if(nil==<Var1>, <Var1>:=<Value1>, nil)[; if(nil==<VarN>, <VarN>:=<ValueN>, nil)] //From Nantucket News, Vol.5, No.4, 1991 (author Mike Schinkel) #xcommand STORE VALUE <Value1> INTO <Var1>[, <ValueN> INTO <VarN>] => if(nil<><Value1>, <Var1>:=<Value1>, nil)[; if(nil<><ValueN>, <VarN>:=<ValueN>, nil)] #xcommand SET ERRORS FILE [TO] <FileName> => SetErrFile( <(FileName)> ) #xcommand SET LASTKEY [TO] <nkey> => SetLastKey(<nkey>) #xcommand SET QUICKESC [TO] <lValue> => SetQuickEsc(<lValue>) #xcommand SET DIALOG [TO] <lValue> => SetDialog(<lValue>) #xcommand CLEAR KEYBOARD => __Keyboard() #xcommand SKIP DELETED => SkipDeleted() #xcommand REFRESH ROW => RefreshRow() #xcommand REFRESH TABLE => RefreshTable() #xcommand APPEND BLANK [IN <alias>[,<order>]] => ; [SwapDatabase(<"alias">,<order>);] DbAppend() [; RestDatabase(<"alias">)] #xcommand DELETE [IN <alias>[,<order>]] [SEEK <key>] => ; [SwapDatabase(<"alias">,<order>);] WEval( {||dbSeek(<key>),Found()}, {||dbDelete(),true} )[; RestDatabase(<"alias">)] #xcommand DELETE [IN <alias>[,<order>]] [FOR <for>] [WHILE <while>] [NEXT <next>] [RECORD <rec>] [<rest:REST>] [ALL] => ; [SwapDatabase(<"alias">,<order>);] DBEval( {||dbDelete()}, <{for}>, <{while}>, <next>, <rec>, <.rest.> )[; RestDatabase(<"alias">)] #xcommand DELETE [IN <alias>[,<order>]] => ; [SwapDatabase(<"alias">,<order>);] dbDelete() [; RestDatabase(<"alias">)] #xcommand RECALL [IN <alias>[,<order>]] [SEEK <key>] => ; [SwapDatabase(<"alias">,<order>);] WEval( {||dbSeek(<key>),Found()}, {||dbRecall(),true} )[; RestDatabase(<"alias">)] #xcommand RECALL [IN <alias>[,<order>]] [FOR <for>] [WHILE <while>] [NEXT <next>] [RECORD <rec>] [<rest:REST>] [ALL] => ; [SwapDatabase(<"alias">,<order>);] DBEval( {||dbRecall()}, <{for}>, <{while}>, <next>, <rec>, <.rest.> )[; RestDatabase(<"alias">)] #xcommand RECALL [IN <alias>[,<order>]] => ; [SwapDatabase(<"alias">,<order>);] dbRecall() [; RestDatabase(<"alias">)] #xcommand REPLACE <f1>:=<v1>[, <fN>:=<vN>] [IN <alias>[,<order>]] [SEEK <key>] => ; [SwapDatabase(<"alias">,<order>);] WEval( {||dbSeek(<key>),Found()}, {||_FIELD-><f1>:=<v1>[, _FIELD-><fN>:=<vN>], true})[; RestDatabase(<"alias">)] #xcommand REPLACE <f1>:=<v1>[, <fN>:=<vN>] [IN <alias>[,<order>]] [FOR <for>] [WHILE <while>] [NEXT <next>] [RECORD <rec>] [<rest:REST>] [ALL] => ; [SwapDatabase(<"alias">,<order>);] DBEval({|| _FIELD-><f1>:=<v1>[, _FIELD-><fN>:=<vN>]}, <{for}>, <{while}>, <next>, <rec>, <.rest.> )[; RestDatabase(<"alias">)] #xcommand REPLACE <f1>:=<v1>[, <fN>:=<vN>] [IN <alias>[,<order>]] => ; [SwapDatabase(<"alias">,<order>);] _FIELD-><f1>:=<v1>[; _FIELD-><fN>:=<vN>] [; RestDatabase(<"alias">)] //-------- NET Commands extension --------------------------------------------- #xcommand NET CREATE <(file1)> [FROM <(file2)>] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => NetCreateFrom(<(file1)>,<(file2)>,<.cont.>.or.<.ret.>) [; if neterr(); return <expr>; end] #xcommand NET USE => DbCloseArea() #xcommand NET USE <(db)> [VIA <rdd>] [ALIAS <a>] [<new:NEW>] [<ex:EXCLUSIVE>] [<sh:SHARED>] [<ro:READONLY>] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; NetDbUseArea(<.new.>, <rdd>, <(db)>, <(a)>, if(<.sh.>.or.<.ex.>, !<.ex.>, nil), <.ro.>, <.cont.>.or.<.ret.> ) [; if neterr(); return <expr>; end] #xcommand NET USE <(db)> [VIA <rdd>] [ALIAS <a>] [<new:NEW>] [<ex:EXCLUSIVE>] [<sh:SHARED>] [<ro:READONLY>] INDEX <list, ...> [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; NetDbUseArea(<.new.>, <rdd>, <(db)>, <(a)>, if(<.sh.>.or.<.ex.>, !<.ex.>, nil), <.ro.>, <.cont.>.or.<.ret.> ) [; if neterr(); return <expr>; end]; if !NetErr(); NetSetIndex(#<list>,<.cont.>.or.<.ret.>); [if neterr(); return <expr>; end;] end #xcommand NET INDEX ON <key> TO <(file)> [<uni:UNIQUE>] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => NetIndexOn(<(file)>,<"key">,<{key}>,if(<.uni.>,.t.,nil),<.cont.>.or.<.ret.>) [; if neterr(); return <expr>; end] #xcommand NET SET INDEX TO => set index to #xcommand NET SET INDEX TO <(i1)>[,<(iN)>] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; NetSetIndex(<(i1)>[+","+<(iN)>],<.cont.>.or.<.ret.>) [; if neterr(); return <expr>; end] #xcommand NET APPEND BLANK [IN <alias>[,<order>]] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] NetDbAppend(<.cont.>.or.<.ret.>) [; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET DELETE [IN <alias>[,<order>]] [SEEK <key>] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] WEval( {||dbSeek(<key>),Found()}, {||NetDbDelete(<.cont.>.or.<.ret.>)} )[; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET DELETE [IN <alias>[,<order>]] [FOR <for>] [WHILE <while>] [NEXT <next>] [RECORD <rec>] [<rest:REST>] [ALL] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] DbEval( {|| NetDbDelete(<.cont.>.or.<.ret.>)}, <{for}>, <{while}>, <next>, <rec>, <.rest.> ) [; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET DELETE [IN <alias>[,<order>]] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] NetDbDelete(<.cont.>.or.<.ret.>) [; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET RECALL [IN <alias>[,<order>]] [SEEK <key>] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] WEval( {||dbSeek(<key>),Found()}, {||NetDbRecall(<.cont.>.or.<.ret.>)} )[; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET RECALL [IN <alias>[,<order>]] [FOR <for>] [WHILE <while>] [NEXT <next>] [RECORD <rec>] [<rest:REST>] [ALL] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] DbEval( {|| NetDbRecall(<.cont.>.or.<.ret.>)}, <{for}>, <{while}>, <next>, <rec>, <.rest.> ) [; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET RECALL [IN <alias>[,<order>]] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] NetDbRecall(<.cont.>.or.<.ret.>) [; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET REPLACE <f1>:=<v1>[, <fN>:=<vN>] [IN <alias>[,<order>]] [SEEK <key>] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] WEval( {||dbSeek(<key>),Found()}, {||NetReplace({||_FIELD-><f1>:=<v1>[, _FIELD-><fN>:=<vN>]}, <.cont.>.or.<.ret.>)}) [; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET REPLACE <f1>:=<v1>[, <fN>:=<vN>] [IN <alias>[,<order>]] [FOR <for>] [WHILE <while>] [NEXT <next>] [RECORD <rec>] [<rest:REST>] [ALL] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] DBEval({|| NetReplace({||_FIELD-><f1>:=<v1>[, _FIELD-><fN>:=<vN>]}, <.cont.>.or.<.ret.>) }, <{for}>, <{while}>, <next>, <rec>, <.rest.> )[; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET REPLACE <f1>:=<v1>[, <fN>:=<vN>] [IN <alias>[,<order>]] [<cont:CONTINUE>] [<ret:RETURN> <expr>] => ; [SwapDatabase(<"alias">,<order>);] NetReplace({||_FIELD-><f1>:=<v1>[, _FIELD-><fN>:=<vN>]}, <.cont.>.or.<.ret.>) [; RestDatabase(<"alias">)] [; if neterr(); return <expr>; end] #xcommand NET RLOCK [<cont:CONTINUE>] [<ret:RETURN> <expr>] => NetRLock(<.cont.>.or.<.ret.>) [; if neterr(); return <expr>; end] #xcommand NET FLOCK [<cont:CONTINUE>] [<ret:RETURN> <expr>] => NetFLock(<.cont.>.or.<.ret.>) [; if neterr(); return <expr>; end] #xcommand NET ERASE <(file)> [<cont:CONTINUE>] [<ret:RETURN> <expr>] => NetFErase(<(file)>,<.cont.>.or.<.ret.>) [; if neterr(); return <expr>; end] #xcommand NET REINDEX [<cont:CONTINUE>] [<ret:RETURN> <expr>] => NetReIndex(<.cont.>.or.<.ret.>) [; if neterr(); return <expr>; end] #xcommand NET PACK [<cont:CONTINUE>] [<ret:RETURN> <expr>] => NetPack(<.cont.>.or.<.ret.>) [; if neterr(); return <expr>; end] #xcommand NET ZAP [<cont:CONTINUE>] [<ret:RETURN> <expr>] => NetZap(<.cont.>.or.<.ret.>) [; if neterr(); return <expr>; end] #xcommand NET UNLOCK [<rest>] => commit; unlock [<rest>] #xcommand NET CLOSE [<rest>] => net unlock [<rest>] ; close [<rest>] //-------- Object oriented support! ------------------------------------------- #xtranslate OBJECT [<Obj>] OF <Class> => [<Obj>:=]<Class>():New() #xtranslate OBJECT <Obj> OF <Class> INIT => <Obj>:=<Class>():New(); <Obj>:Init() #xtranslate OBJECT <Obj> OF <Class> INIT <*Tail*> => <Obj>:=<Class>():New(); <Obj>:Init(); (<Tail>) #ifdef CLASSY #include "Class(y).ch" #xtranslate :SUPER([<class>]): => :super: #xcommand METHOD NEW=<*tail*> => #xcommand CONSTRUCTOR <ctor>() => ; static function New();; local __csyDummy:=qself():super:New();; local self:=qself() #else #include "OClip.ch" #endif //-------- Color access ------------------------------------------------------- #define nNormal 1 //CLIPPER:Normal,Enhanced,Border,NotUse,Unselect #define nEnhanced 2 #define nBorder 3 #define nNotUse 4 #define nUnSelect 5 #define nShadow 3 //WINDOW: Normal,Enhanced,Shadow,Title, Unselect #define nTitle 4 #define nSelected 2 //MENU: Normal,Selected,Shadow,Letter,Disable #define nLetter 4 #define nDisable 5 #define nExtension 6 //-------- Various constants for Object.lib ----------------------------------- #define DISABLE "__DISABLE" #define DisableHelp() ReadHelpVar(DISABLE) #define EnableHelp() ReadHelpVar("") #define OD_SCREEN "1" //output device for function OutputDevice(dev) #define OD_PRINTER "2" //output device for function OutputDevice(dev) //can be also: FullPathAndFileName #define cTempFile "SysTmp$$" //temporary dbf,ntx see c_Dbf.prg, c_Report.prg #define cErrFile "SysError.txt" //see Object1.prg #define cBasic "System1" //ƒø //paswords #define cIFR "System2" //ƒ≈ƒ> Object.lib databases //indexes, filters, reports #define cHelp "System3" //ƒŸ //help #define cNtxFile "SysN" //SysN9999.ntx //9999 number defined inside View`InsIndex() //LEGTH OF STRING cNtxFile MUST BE 4 CHARs!!! #define cRptFile "SysR" //SysR9999.txt //9999 number defined inside Report`VProcess() //LEGTH OF STRING cRptFile MUST BE 4 CHARs!!! #define nNetWaitSec 1 //Object1.prg #define nVPaintWaitSec 2 //Browse.prg #define nLenPsw 20 //length of user_id and password #define nMinMemory 40 //for running archivation (in kB) #define nLenIFRName 30 //length of name for Index/Filter/Report menu item #define nLenColTitle 15 //max length of column title of report #define nLenTopBottom 58 //width of edit window for insert Top and Bottom text of report #define nLenIFRData 250 //length of Data item in file cIFR (see C_DBF.prg->CreateBasic1() too) #define nMaxPrintCols 512 //max. width of report in columns #define nSwapTask 255 //keyboard_code: force exit for all windows applications (need for task switching) #define nWaitForKey 254 //keyboard_code: need for ShowTime() in AChoice and MemoEdit(). #define nLongName 1 //ƒø #define nShortName 2 // √ƒ> used as array indexes into Get:Cargo[] #define nAlias 3 // ≥ #define nRowOffset 4 // ≥ (for Browse:FormActive, need for setting Get:Row in Mask() class) #define nColOffset 5 //ƒŸ (for Browse:FormActive, need for setting Get:Col) #define nLenCargo 5 // length of Get:Cargo[] array //-------------------------------------------------- eof (c)JHK --------------- 
